home *** CD-ROM | disk | FTP | other *** search
/ Clickx 115 / Clickx 115.iso / software / tools / windows / tails-i386-0.16.iso / live / filesystem.squashfs / usr / share / audacity / plug-ins / clipfix.ny < prev    next >
Encoding:
Audacity Nyquits plug-in  |  2010-09-21  |  5.2 KB  |  130 lines

  1. ;nyquist plug-in
  2. ;version 1
  3. ;type process
  4. ;categories "http://audacityteam.org/namespace#NoiseRemoval"
  5. ;name "Clip Fix..."
  6. ;action "Reconstructing clips..."
  7. ;info "Designed and implemented by Benjamin Schwartz.\n\nClip Fix attempts to reconstruct clipped regions by interpolating the\nlost signal. Before use, reduce amplification by 10 dB to give room for\nthe reconstruction. 'Threshold' is how close to the maximum sample\nmagnitude any sample must be to be considered clipped. If processing\nis slow, select only a few seconds of clipped audio at a time."    
  8. ;control thresh "Threshold of Clipping [%]" real "" 95 0 100
  9. (setf largenumber 100000000) ;;Largest number of samples that can be imported
  10. (setf blocksize 100000)
  11.  
  12. ;;Clip Fix is a simple, stupid (but not blind) digital-clipping-corrector
  13. ;;The algorithm is fairly simple:
  14. ;;1. Find all clipped regions
  15. ;;2. Get the slope immediately on either side of the region
  16. ;;3. Do a cubic spline interpolation.
  17. ;;4. Go to next region
  18.  
  19. ;;Coded from start (didn't know lisp (well, scheme, but not not lisp and certainly not
  20. ;;some XLISP 2.0 derivative)) to finish
  21. ;;(fully working, more or less) in one afternoon (and some evening).
  22. ;;Written by Benjamin Schwartz, MIT class of 2006, on May 25, 2004.
  23. ;;Explanatory text added by Gale Andrews, May 2008.
  24. ;;If you modify this code, please retain the original credit to Benjamin Schwartz.
  25.  
  26. (defun declip (sin) ;;Central function
  27. (let* ((threshold  (* (peak sin largenumber) thresh 0.01))
  28. (s2 (snd-copy sin))
  29. (samplerate (snd-srate s2))
  30. (s2length (snd-length s2 largenumber)))
  31.  
  32. (seqrep (i (1+ (/ s2length blocksize)))
  33.   (let ((l (min blocksize (- s2length (* i blocksize)))))
  34.      ;;(print (list i t0 l samplerate))
  35.      (snd-from-array 0 samplerate 
  36.     (workhorse 
  37.         ;;(let () (print (list s2 (type-of s2) l (type-of l)))
  38.             (snd-fetch-array s2 l l)
  39.         ;;)
  40.             threshold))))
  41.  
  42. ;;(setf r (snd-fetch-array (snd-copy s) (snd-length s largenumber) 1)) ;;Create a sound array
  43. ;;(snd-from-array (snd-t0 s) (snd-srate s) (workhorse r threshold))
  44. ))
  45.  
  46. (defun workhorse (r threshold)
  47.  
  48. (setf n (length r)) ;; Record its length
  49.  
  50. (setf exithigh ()) ;;Times when the wavefrom left the allowed region
  51. (setf returnhigh ())  ;;Times when it returned to the allowed region
  52.  
  53. (setf drange 4)
  54.  
  55. (let ((i drange) (max (- n drange))) ;;Leave room at ends for derivative processing
  56.   (while (< i max)
  57.   (if (>= (aref r i) threshold) 
  58.     (if (< (aref r (- i 1)) threshold)
  59.       (setq exithigh (cons (- i 1) exithigh))) ;;We just crossed the threshold up
  60.     (if (>= (aref r (- i 1)) threshold)
  61.       (setq returnhigh (cons i returnhigh)))) ;;We just crossed the threshold down
  62.   (setq i (1+ i))))
  63.  
  64. (setq exithigh (reverse exithigh)) ;;List comes out backwards
  65. (setq returnhigh (reverse returnhigh))
  66.  
  67. (if (>= (aref r (1- drange)) threshold) ;;If the audio begins in a clipped region, ignore 
  68.   (setq returnhigh (cdr returnhigh))) ;the extra return from threshold
  69.  
  70. (setf exitlow ())  ;; Same as above, but for the bottom threshold
  71. (setf returnlow ())
  72.  
  73. (setf threshlow (* -1 threshold)) ;;Assumes your digital range is zero-centered
  74.  
  75.  
  76. (let ((i drange) (max (- n drange)))
  77.   (while (< i max)
  78.   (if (<= (aref r i) threshlow)
  79.     (if (> (aref r (- i 1)) threshlow)
  80.       (setq exitlow (cons (- i 1) exitlow)))
  81.     (if (<= (aref r (- i 1)) threshlow)
  82.       (setq returnlow (cons i returnlow))))
  83.   (setq i (1+ i))))
  84.  
  85. (setq exitlow (reverse exitlow))
  86. (setq returnlow (reverse returnlow))
  87.  
  88. (if (<= (aref r (1- drange)) threshlow)
  89.   (setq returnlow (cdr returnlow)))
  90.  
  91. (while (and exithigh returnhigh) ;;If there are more clipped regions
  92.     (let* ((t1 (car exithigh))  ;;exit time
  93.           (t2 (car returnhigh)) ;;return time
  94.           (d1 (max 0 (/ (- (aref r t1) (aref r (- t1 (1- drange)))) (1- drange)))) ;;slope at exit
  95.           (d2 (min 0 (/ (- (aref r (+ t2 (1- drange))) (aref r t2)) (1- drange)))) ;;slope at return
  96.           (m (/ (+ d2 d1) (* (- t2 t1) (- t2 t1)))) ;;interpolation is by (t-t1)(t-t2)(mx+b)
  97.           (b (- (/ d2 (- t2 t1)) (* m t2))) ;;These values of m and b make the cubic seamless
  98.           (j (1+ t1))) ;; j is the index
  99.  
  100.      (while (< j t2)
  101.          (setf (aref r j) (+ (aref r t1) (* (- j t1) (- j t2) (+ (* m j) b)))) 
  102.      (setf (aref r j) (+ (* (- t2 j) (/ (aref r t1) (- t2 t1))) (* (- j t1) (/ (aref r t2) (- t2 t1)))  (* (- j t1) (- j t2) (+ (* m j) b))))
  103.          (setq j (1+ j)))) 
  104.      (setq exithigh (cdr exithigh))
  105.      (setq returnhigh (cdr returnhigh)))
  106.  
  107. (while (and exitlow returnlow) ;;Same for bottom
  108.     (let* ((t1 (car exitlow))
  109.           (t2 (car returnlow))
  110.           (d1 (min 0 (/ (- (aref r t1) (aref r (- t1 (1- drange)))) (1- drange)))) ;;slope at exit
  111.           (d2 (max 0 (/ (- (aref r (+ t2 (1- drange))) (aref r t2)) (1- drange)))) ;;slope at return
  112.           (m (/ (+ d2 d1) (* (- t2 t1) (- t2 t1))))
  113.           (b (- (/ d2 (- t2 t1)) (* m t2)))
  114.       (a (/ (+ (aref r t1) (aref r t2)) 2))
  115.           (j (1+ t1)))
  116.      (while (< j t2)
  117.          (setf (aref r j) (+ (* (- t2 j) (/ (aref r t1) (- t2 t1))) (* (- j t1) (/ (aref r t2) (- t2 t1)))  (* (- j t1) (- j t2) (+ (* m j) b))))
  118.          (setq j (1+ j))))
  119.      (setq exitlow (cdr exitlow))
  120.      (setq returnlow (cdr returnlow)))
  121.  
  122. r)
  123.  
  124. (if (arrayp s)
  125.   (dotimes (j (length s))
  126.     (setf (aref s j) (declip (aref s j))))
  127.   (setq s (declip s)))
  128.  
  129. s
  130.